home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / gsdb21.arc / GSDBDATA.PAS < prev    next >
Pascal/Delphi Source File  |  1991-01-04  |  7KB  |  280 lines
  1. program GSdBData;
  2. uses
  3.    CRT,
  4.    DOS,
  5.    Printer,
  6.    GS_KeyI,
  7.    GS_dBFld,
  8.    GS_Pick,
  9.    GS_Wind,
  10.    GS_dBTbl,
  11.    GS_dBase;
  12.  
  13. const
  14.  
  15.    Initial_Count  = 5;
  16.    Initial_Choice : array [1..Initial_Count] of string[9] =
  17.                     (' Choose  ',' Print   ',' FileIt  ',' Pack    ',' Exit    ');
  18.  
  19. var
  20.    GSdBFile  : GS_dBFld_Objt;
  21.    AskWin,
  22.    StatusWin,
  23.    GSdBWin,
  24.    GSMoWin   : GS_Wind_Objt;
  25.    GSdBTab   : dbTabl_Pick_Obj;
  26.  
  27. procedure ShowFile;
  28. var
  29.    i,
  30.    ml : integer;
  31.    vl,
  32.    vs : boolean;
  33.    aw : string[1];
  34. begin
  35.    StatusWin.SetWin;
  36.    write('':10,'ESC to Abort,  F10 to Quit and Save,',
  37.                '  F9 to Delete/Undelete');
  38.    vl := true;
  39.    while vl do
  40.    begin;
  41.       GSMoWin.SetWin;
  42.       ClrScr;
  43.       if not GSdBTab.Addrec then
  44.       begin
  45.          GSdBFile.MemoGet(GSdBFile.FieldGet('COMMENTS'));
  46.          ml := GSdBFile.MemoLines;
  47.          if ml > 12 then ml := 12;
  48.          for i := 1 to ml do
  49.          begin
  50.             gotoxy(1,i);
  51.             write(GSdBFile.MemoGetLine(i));
  52.          end;
  53.       end;
  54.       GSdBWin.SetWin;
  55.       ClrScr;
  56.       if GSdBTab.Addrec then
  57.       begin
  58.          vs := false;
  59.          vl := GSdBFile.FieldAppendScreen(false);
  60.          if not vl then
  61.          begin
  62.             if GSdBFile.RecChanged then
  63.             begin
  64.                AskWin.BoxName := '';
  65.                AskWin.SetWin;
  66.                gotoxy(1,2);
  67.                writeln(' Record has been modified!');
  68.                write(' Save before exit? ');
  69.                aw := GSdBFile.EditString('Y',21,3,1);
  70.                vs := aw[1] in ['T','t','Y','y'];
  71.                AskWin.RelWin;
  72.             end;
  73.          end;
  74.          if vl or vs then
  75.          begin
  76.             GSdBFile.Append;
  77.             GSdBTab.Reset_dBTabl;
  78.          end;
  79.       end
  80.       else
  81.       begin
  82.          vs := false;
  83.          vl := GSdBFile.FieldUpdateScreen;
  84.          if not vl then
  85.          begin
  86.             if GSdBFile.RecChanged then
  87.             begin
  88.                AskWin.BoxName := '';
  89.                AskWin.SetWin;
  90.                gotoxy(1,2);
  91.                writeln(' Record has been modified!');
  92.                write(' Save before exit? ');
  93.                aw := GSdBFile.EditString('Y',21,3,1);
  94.                vs := aw[1] in ['T','t','Y','y'];
  95.                AskWin.RelWin;
  96.             end;
  97.          end;
  98.          if vl or vs then
  99.          begin
  100.             GSdBFile.PutRec(GSdBFile.RecNumber);
  101.             if GS_KeyI_Chr = Kbd_PgUp then
  102.                GSdBFile.GetRec(Prev_Record)
  103.             else
  104.                GSdBFile.GetRec(Next_Record);
  105.          end;
  106.       end;
  107.       GSdBWin.RelWin;
  108.       GSMoWin.RelWin;
  109.    end;
  110.    StatusWin.RelWin;
  111. end;
  112.  
  113.  
  114. procedure FileDisplay;
  115. var
  116.    t : string[8];
  117.    i : integer;
  118.    z,
  119.    wcr : boolean;
  120. begin
  121.    wcr := GSdBFile.Wait_CR;
  122.    GSdBFile.Wait_Cr := true;
  123.    AskWin.boxname := '[ Label Name ]';
  124.    AskWin.SetWin;
  125.    gotoxy(1,1);
  126.    write('Enter label name:');
  127.    t := GSdBFile.EditString('',8,2,20);
  128.    GSdBFile.Wait_CR := wcr;
  129.    AskWin.RelWin;
  130.    if GS_KeyI_Esc then exit;
  131.    GSdBTab.Reset_dBTabl;
  132.    repeat
  133.       StatusWin.SetWin;
  134.       write('':22,'ESC to Exit,  RETURN to Select Entry');
  135.       if GSdBTab.Tabl = nil then
  136.          z := GSdBTab.Scan_dBTabl('LABEL',t,'LABEL+"  ["+OBJECT+"]"')
  137.       else
  138.       begin
  139.          GSdBTab.Pick_Win.SetWin;
  140.          z := GSdBTab.Choose_dBTabl;
  141.          GSdBTab.Pick_Win.RelWin;
  142.       end;
  143.       StatusWin.RelWin;
  144.       if z then ShowFile;
  145.    until not z;
  146.    GSdBTab.Reset_dBTabl;
  147. end;
  148.  
  149. procedure Print_List;
  150. var
  151.    i,
  152.    ml,
  153.    lines : integer;
  154.  
  155.    procedure Page_Top;
  156.    begin
  157.       if lines > 0 then writeln(lst,#12);
  158.       lines := 0;
  159.    end;
  160.  
  161. begin
  162.    lines := 0;
  163.    Page_Top;
  164.    ClrScr;
  165.    with GSdBFile do
  166.    begin
  167.       GetRec(Top_Record);
  168.       while not File_EOF do
  169.       begin
  170.          writeln(FieldGet('label'),
  171.                  FieldGet('type'):12,
  172.                  FieldGet('unit'):25);
  173.          if lines > 56 then Page_Top;
  174.          writeln(lst);
  175.          writeln(lst,'__________________________________________________');
  176.          writeln(lst);
  177.          inc(lines,3);
  178.          writeln(lst,
  179.                      FieldGet('label'),
  180.                      FieldGet('type'):12,
  181.                      '   Unit: ',
  182.                      FieldGet('unit'));
  183.          inc(lines);
  184.          writeln(lst);
  185.          inc(lines);
  186.          MemoGet(FieldGet('COMMENTS'));
  187.          ml := MemoLines;
  188.          for i := 1 to ml do
  189.          begin
  190.             writeln(lst,MemoGetLine(i));
  191.             inc(lines);
  192.             if lines > 60 then Page_Top;
  193.          end;
  194.          if lines > 60 then Page_Top;
  195.          GetRec(Next_Record);
  196.       end;
  197.    end;
  198.    writeln(lst,#12);
  199. end;
  200.  
  201. procedure File_List;
  202. var
  203.    i,
  204.    ml,
  205.    lines : integer;
  206.    fil   : text;
  207.  
  208. begin
  209.    assign(fil,'gsdblist.txt');
  210.    rewrite(fil);
  211.    ClrScr;
  212.    with GSdBFile do
  213.    begin
  214.       GetRec(Top_Record);
  215.       while not File_EOF do
  216.       begin
  217.          writeln(FieldGet('label'),
  218.                  FieldGet('type'):12,
  219.                  FieldGet('unit'):25);
  220.          writeln(fil,'__________________________________________________');
  221.          writeln(fil);
  222.          writeln(fil,
  223.                      #02,FieldGet('label'),#02,
  224.                      FieldGet('type'):12,
  225.                      '   Unit: ',
  226.                      FieldGet('unit'));
  227.          writeln(fil);
  228.          MemoGet(FieldGet('COMMENTS'));
  229.          ml := MemoLines;
  230.          for i := 1 to ml do
  231.          begin
  232.             writeln(fil,MemoGetLine(i));
  233.          end;
  234.          GetRec(Next_Record);
  235.       end;
  236.    end;
  237.    system.close(fil);
  238. end;
  239.  
  240. procedure What_Now;
  241. var
  242.    c1 : char;
  243.    q : integer;
  244. begin
  245.    q := 1;
  246.    while q < Initial_Count do
  247.    begin
  248.       StatusWin.SetWin;
  249.       q := GS_Pick_Line_Item(Initial_Choice,10,Initial_Count,q);
  250.       StatusWin.RelWin;
  251.       case q of
  252.          1 : FileDisplay;
  253.          2 : Print_List;
  254.          3 : File_List;
  255.          4 : GSdBFile.Pack;
  256.       end;
  257.    end;
  258. end;
  259.  
  260. begin
  261.    ClrScr;
  262.    GSdBFile.Init('GSDBDATA');
  263.    GSdBFile.Open;
  264. {   GSdBFile.IndexTo('GSDBDATA','SECTION+LABEL');}
  265.    GSdBFile.Index('GSDBDATA');
  266.    GSdBFile.MemoWidth(72);
  267.    GSdbWin.InitWin(1,1,80,10,Yellow,Green,LightGray,Yellow,Red,true,
  268.                    '',false);
  269.    GSMoWin.InitWin(1,11,80,24,Black,Green,LightGray,Yellow,Red,true,
  270.                    '[ COMMENTS ]',false);
  271.    AskWin.InitWin(20,8,60,11,Yellow,Blue,Yellow,Black,LightGray,true,
  272.                   '',true);
  273.    StatusWin.InitWin(1,25,80,25,Yellow,Red,Yellow,Red,LightGray,false,'',true);
  274.    GSdBTab.Init_dbTabl(GSdBFile, '[ ITEMS ]',10,2,70,22,
  275.                        Yellow,Blue,LightGray,Blue,LightGray);
  276.    GSdBTab.Append_dBTabl(true);
  277.    What_Now;
  278.    GSdBFile.Close;
  279. end.
  280.